home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
C64
/
H-Graphics
/
(c)h7.d64
/
hrtest.c
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2007-02-04
|
2KB
|
85 lines
10 IF A=0 THEN A=1:LOAD"HRSUPP.D",8,1
20 BA=6*16^3:REM BASE ADDRESS
30 IN=BA:REM INITIALIZE
40 RS=BA+3:REM RESTORE
50 CL=BA+6:REM CLEAR
60 DR=BA+9:REM DRAW
70 PX=BA+12:REM SET PIXEL ON
80 MV=BA+15:REM MOVE
90 SYS(IN)
95 :
100 S=3:SYS(MV),S,S:FOR I=S TO 195 STEP S
110 X1=S:Y1=X1:X2=X1:Y2=Y1+I
120 X3=X2+I:Y3=Y2:X4=X3:Y4=Y3-I
130 SYSDR,X2,198
140 SYSDR,X3,Y3
150 SYSDR,X4,Y4
160 SYSDR,X1,Y1
170 NEXT I
180 GET A$:IF A$<>"C" THEN 180
190 :
200 R=80:XC=160:YC=100:A=(null)/180:S=5
210 SYS(CL)
220 FOR AN = 0 TO (null)/1.99 STEP (null)/20
230 SYSMV,XC+R*SIN(AN),YC+R*SIN(AN)
240 FOR I=S TO 360 STEP S
250 SYSDR,XC+R*SIN(2*I*A+AN),YC+R*SIN(I*A+AN)
260 NEXT I,AN
270 GET A$:IF A$<>"C" THEN 270
280 :
300 SYS(CL)
310 D=4:E=2:X=XC:Y=YC
320 SYSMV,X,Y
330 FOR I=0 TO 20
340 D=D+E:Y=Y+D:SYSDR,X,Y
350 D=D+E:X=X+D:SYSDR,X,Y
360 D=D+E:Y=Y-D:SYSDR,X,Y
370 D=D+E:X=X-D:SYSDR,X,Y
380 NEXT I
390 GET A$:IF A$<>"C" THEN 390
395 :
400 SYSCL:S=(null)/3
410 FOR T=0 TO S STEP S/8
420 SYSMV,XC+R*COS(T),YC+R*SIN(T)
430 FOR I=S TO 2*(null) STEP S
440 SYSDR,XC+R*COS(I+T),YC+R*SIN(I+T)
450 NEXT I,T
460 GET A$:IF A$<>"C" THEN 460
470 :
500 SYSCL:S=(null)/4:D=R/20
510 FOR T=0 TO S STEP S/20
520 SYSMV,XC+R*COS(T),YC+R*SIN(T)
530 FOR I=S TO 2*(null) STEP S
540 SYSDR,XC+R*COS(I+T),YC+R*SIN(I+T)
550 NEXT I
560 R=R-D:NEXT T
580 GET A$:IF A$<>"C" THEN 580
590 :
600 SYSCL:R=80:S=(null)/8:D=R/20
610 FOR T=0 TO S STEP S/40
620 SYSPX,XC+R*COS(T),YC+R*SIN(T)
630 FOR I=S TO 2*(null) STEP S
640 SYSPX,XC+R*COS(I+T),YC+R*SIN(I+T)
650 NEXT I
660 R=R-D:NEXT T
680 GET A$:IF A$<>"C" THEN 680
690 :
700 SYSCL:R=80:S=2*(null)/5:A=(null)/10
710 FOR I=0 TO 4
720 T=A+I*S
730 X(I)=XC+R*COS(T):Y(I)=YC+R*SIN(T)
740 NEXT I
750 SYSMV,X(0),Y(0)
760 SYSDR,X(2),Y(2):SYSDR,X(4),Y(4)
770 SYSDR,X(1),Y(1):SYSDR,X(3),Y(3)
780 SYSDR,X(0),Y(0)
790 GET A$:IF A$<>"C" THEN 760
795 :
800 SYSCL:A=160:B=A/2:SYSMV,0,A*EXP(-4)
810 FOR X=4 TO 2*A-1 STEP 4
820 SYSDR,X,A*EXP(-((X-A)/B)^2)
830 NEXT X
880 GET A$:IF A$<>"C" THEN 880
890 :
9999 SYS(RS)